open Geo;;


(* TYPES *)
type mur = Geo.segment
type sexe = Male | Femelle
type espece = Chat | Souris of souris
  and souris = Sa of sexe*bool | Sf of int*bool | So of sexe * int
type animal = { p : Geo.point; pvis : float; ract : float; esp : espece; }
type visibilite = Rien |A of animal


let continue = ref false


let (create_liste_surface_animaux:animal list->Geo.surface list) = fun la ->
	 let rec aux = fun l res -> 
    match l with
    | [] -> res
    | a::end_list ->
			begin
				match a.esp with
					Souris(n) ->
					begin
						match n with
							Sa(_,_) -> let c = Geo.Circle(a.p,0.005) in aux end_list (res@[c])	
							| So(_,_) -> let c = Geo.Circle(a.p,0.003) in aux end_list (res@[c])
							| Sf (_,_) -> let c = Geo.Circle(a.p,0.008) in aux end_list (res@[c])
					end
					|Chat -> 
						let tri = Geo.Polygon [a.p;(Geo.point (a.p.x-.0.01) (a.p.y+.0.01));(Geo.point (a.p.x+.0.01) (a.p.y+.0.01))] in
						aux end_list (res@[tri])	
			end
  in aux la []


let (murtosurface:mur -> Geo.surface) = fun m ->
	Line(m.p1,m.p2)
	
let (create_liste_surface_murs:mur list -> surface list) = fun lm ->
  List.map (murtosurface) lm


let liste_animaux = ref []
let liste_murs = ref []
let liste_surface = ref []

(*************************************************************)
(* Fonctions de déplacement du jeu *)
(*************************************************************)

(* FUNCTION *)
(*-----------------------------------------*)

let (mvon: Geo.point -> Geo.point) = fun p ->
	let newx = if p.x>1. then p.x -.1. else if p.x<0. then p.x +.1. else  p.x in
  let newy = if p.y>1. then p.y -.1. else if p.y<0. then p.y +.1. else p.y in
  {x=newx;y=newy} 
	

let (destination: animal -> Geo.point) = fun a ->
  let temp = a.p +| (rotate { x= (Random.float a.ract); y =0.;} (Random.float (2.*.pi))) in
 (* let newx = if temp.x>1. then temp.x -.1. else if temp.x<0. then temp.x +.1. else  temp.x in
  let newy = if temp.y>1. then temp.y -.1. else if temp.y<0. then temp.y +.1. else temp.y in
  {x=newx;y=newy} *) temp

(*-----------------------------------------*)
let rec (modifsphere:animal list -> animal list) = fun la ->
	List.map (fun a -> {a with p = mvon (destination a) }) la

(*-----------------------------------------*)
let (croise:animal-> point -> mur -> bool) = fun a p m ->
  seCroisent {p1=a.p;p2=p} m

(*-----------------------------------------*)
let (longe:animal-> point -> mur -> point) = fun a p m ->
  let pc = pointCommun {p1=a.p;p2=p} m in
  let drestant = (distance p a.p) -. (distance pc a.p) in
  let vu1 = unitise (pc -| a.p) in
  let vu2 = unitise (m.p2 -| pc) in
	let pcdec = pc +| (0.01 *| (~| vu1)) in  (* pour pas etre dans le mur *)
  let angle = acos (dot vu1 vu2) in
  if angle > (pi/.2.) then
    pcdec +| (drestant/.(distance (m.p1) pc)) *| ((m.p1) -| pc)
  else if angle < (pi/.2.) then
    pcdec +| (drestant/.(distance (m.p2) pc)) *| ((m.p2) -| pc)
  else
    if Random.bool() then
      pcdec +| (drestant/.(distance (m.p1) pc)) *| ((m.p1) -| pc)
    else
      pcdec +| (drestant/.(distance (m.p2) pc)) *| ((m.p2) -| pc)

(*-----------------------------------------*)
let (aportevu:animal->animal-> bool) = fun a1 a2 ->
  ((distance a1.p a2.p) <= a1.pvis) 
(*
|| ((distance a1.p {x=a2.p.x-1;y=a2.p.y-1}) <= a.pvis)
|| ((distance a1.p {x=a2.p.x+0;y=a2.p.y-1}) <= a.pvis)
|| ((distance a1.p {x=a2.p.x+1;y=a2.p.y-1}) <= a.pvis)
|| ((distance a1.p {x=a2.p.x-1;y=a2.p.y+0}) <= a.pvis)
|| ((distance a1.p {x=a2.p.x+1;y=a2.p.y+0}) <= a.pvis)
|| ((distance a1.p {x=a2.p.x-1;y=a2.p.y+1}) <= a.pvis)
|| ((distance a1.p {x=a2.p.x+0;y=a2.p.y+1}) <= a.pvis)
|| ((distance a1.p {x=a2.p.x+1;y=a2.p.y+1}) <= a.pvis)*)

(*-----------------------------------------*)
let(estvisible:animal->animal->mur->bool) = fun a1 a2 m ->
  if not (aportevu a1 a2) then false
  else
    not (croise a1 (a2.p) m)

(*-----------------------------------------*)
(* Le premier parametre animal est un chat et une liste de souris *)
let (proie:animal->animal list -> mur -> visibilite) = fun a la m ->
  match a.esp with
  	Chat ->
			let rec (cibleChat:animal->animal list->mur->visibilite->visibilite) = fun a la m sourisProche ->
				print_int (List.length la);
	  		begin
	    		match la with
						[] -> sourisProche
	      		|el::laf ->
							begin
		  					match el.esp with
		      				Chat -> cibleChat a laf m sourisProche
		    					|Souris _ -> 
		      					if estvisible a el m then
											match sourisProche with
			    							Rien -> cibleChat a laf m (A el) 
			  								|A a_proche -> 
			    								if (distance (a.p) (a_proche.p)) > (distance (a.p) (el.p)) then 
			      								cibleChat a laf m (A el)
			    								else
			      								cibleChat a laf m sourisProche
		      					else
											cibleChat a laf m sourisProche
							end
	  		end
			in cibleChat a la m Rien
    |_ ->  failwith "Pas implementé"
    
(*-----------------------------------------*)
(* Prerequis : le chat doit etre visible*)
(*  *)
let (fuite: animal -> animal -> mur -> point) = fun s c m ->
	let p2 = s.p +| ( s.ract *| unitise ( s.p -| c.p) ) in
	if not ( croise s p2 m ) then
		p2
	else
		longe s p2 m

(*-----------------------------------------*)
let (poursuite: animal -> animal -> mur -> point) = fun c s m ->
	let vect = s.p -| c.p in
	if (length vect) < c.ract then
		s.p
	else
		c.p +| ( s.ract *| (unitise vect) )
		
(*-----------------------------------------*)
(* on se trouve au tour ou la souris c1 doit bouger *)
let (copule: animal -> animal -> mur -> point*animal*animal) = fun c1 c2 m ->
	let vect = c2.p -| c1.p in
	let p2 = c1.p +| ( c1.ract *| unitise ( c2.p -| c1.p) ) in
	if (length vect) < c1.ract then
		(p2,c1,c2)		
	else
		match c1.esp with
			  Souris(Sa(s,b)) when s = Femelle -> (p2,{c1 with p= mvon p2;esp = Souris(Sf(3,false))},{c2 with p= mvon p2;esp = Souris(Sa(Male,false))})
			| Souris(Sa(s,b)) when s = Male -> (p2,{c1 with p= mvon p2;esp = Souris(Sa(Male,false))},{c2 with p= mvon p2;esp = Souris(Sf(3,false))})
			| _ -> failwith "mauvaise espèce"

	
(*-----------------------------------------*)
let (naissance: animal -> animal list) = fun s ->
	let nbs = ( Random.int 5) in
	let rec (aux : int -> animal list -> animal list) = fun i l ->
		if i > 0 then
			let news = {p = s.p; pvis = (((Random.float 0.5)+.0.25)*.s.pvis);ract = (((Random.float 0.5)+.0.25)*.s.ract); esp =Souris(So((if Random.bool() then Male else Femelle),3))} in
			aux (i-1) (news::l)
		else
			l
	in
	aux nbs []

(*---------------------------------------------------------------------------------------------- *)
let (chatVisible:animal -> animal list -> mur -> visibilite) = fun s la m ->
  let rec (aux:animal -> animal list -> mur -> visibilite -> visibilite) = fun s la m tempV ->
    match s.esp with
	    |Chat -> failwith "s est une souris.."
      |Souris sour ->
	begin
	  match la with
	    |[] -> tempV
	    |a::reste ->
		  	if estvisible s a m then
		    	match a.esp with
		    	  |Souris _ -> aux s reste m tempV
		    	  |Chat ->
			  	  begin
			  	    match tempV with
							|Rien -> aux s reste m (A a)
							|A a_procheV ->
					  	begin
					    	match a_procheV.esp with
					      	|Souris _ -> aux s reste m (A a)
					      	|Chat -> 
						    	if (distance (s.p) (a_procheV.p)) > (distance (s.p) (a.p)) then 	
						    	  aux s reste m (A a)
						    	else
						    	  aux s reste m tempV
					  	end
			  		  end
				else
						aux s reste m tempV
	end
  in aux s la m Rien
  
(*---------------------------------------------------------------------------------------------- *)
  
 let (sexeOppVisible:animal -> animal list -> mur -> visibilite) = fun s la m ->
  let rec (aux:animal -> animal list -> mur -> visibilite -> visibilite) = fun s la m tempV ->
    match s.esp with
	    |Chat -> failwith "s est une souris.."
      |Souris sour ->
	begin
	  match la with
	    |[] -> tempV
	    |a::reste ->
		  	if estvisible s a m then
		    	match a.esp with
		    	  |Chat -> aux s reste m tempV
		    	  |Souris sour2 ->
							begin
								match sour,sour2 with
									(Sa (s1,_)),(Sa (s2,_)) when s1=s2 -> aux s reste m tempV
									|(Sa (_,_)),(Sa (_,_)) ->			
								begin
			  	    		match tempV with
									|Rien -> aux s reste m (A a)
									|A a_procheV ->
					  			begin
					    			match a_procheV.esp with
					      			|Chat -> aux s reste m tempV
					      			|Souris _ -> 
						    				if (distance (s.p) (a_procheV.p)) > (distance (s.p) (a.p)) then 	
						    	  			aux s reste m (A a)
						    				else
						    	  			aux s reste m tempV
									end	
					  		end
								|_ -> aux s reste m tempV
			  		 	end
				else
						aux s reste m tempV
	end
  in aux s la m Rien
  
(*---------------------------------------------------------------------------------------------- *)

let (prioSouris:animal -> animal list -> mur -> visibilite) = fun s la m ->
	let chat = chatVisible s la m in
		match chat with
			|Rien -> sexeOppVisible s la m
			|A a->
				begin
					match a.esp with
						Chat -> chat
						|_ -> failwith "C'est possible ca ?"
				end
(*---------------------------------------------------------------------------------------------- *)
let (egal:animal->animal->bool) = fun a1 a2 ->
	a1.p=a2.p &&
	a1.pvis=a2.pvis &&
	a1.ract=a2.ract &&
	match a1.esp,a2.esp with
		|Chat,Chat -> true
		|Souris s1,Souris s2 -> 
			begin
				match s1,s2 with
					|Sa(a,b),Sa(c,d) when a=c && b=d -> true
					|Sf(a,b),Sf(c,d) when a=c && b=d -> true
					|So(a,b),So(c,d) when a=c && b=d -> true
					|_ -> false
			end
		|_ -> false
(*---------------------------------------------------------------------------------------------- *)
let (modifSouris: animal -> animal -> animal list -> animal list) = fun initS newS la ->
	let (auxMS:animal -> animal-> animal-> animal) = fun initS newS sActuel  -> 
		if egal sActuel initS then
 			newS
		else
			sActuel
	in
	List.map (auxMS initS newS) la
(*---------------------------------------------------------------------------------------------- *)
let rec (suppr1Souris:animal->animal list -> animal list) = fun s la ->
	match la with
		[] -> []
		|a::reste -> 
			if egal a s then 
				reste
			else
				 a::(suppr1Souris s reste)
				 
(*---------------------------------------------------------------------------------------------- *)				
let (modifpleinair:animal list -> mur list -> animal list) = fun la m ->
	let lai = la in
	let mur = ( List.hd m) in
	let rec (aux: animal list-> mur -> animal list -> animal list) = fun l mu res ->
		match l with 
			[] -> res
			| h::t ->
			begin
				match h.esp with
					Chat ->
						let pr = (proie h (List.filter (fun a -> match a.esp with Souris(_) -> true | Chat -> false) (l@res)) mur ) in
						begin 
							match pr with
								(* il n'y a pas de proies*)
							Rien ->
								let p2 = destination h in
						  		if not (croise h p2 mur) then
									aux t mur res@[{h with p = mvon p2 }] (* ICI SA RENTRE TT LE TEMPS*)
								else
									aux t mur res@[{h with p = mvon (longe h p2 mur)}]
							| A(n) ->
								(* Il y a une proie qui est visible , il n'y a donc pas de mur entre le chat et la souris*)
								let pc = poursuite h n mur in
								if (pc.x = n.p.x) && (pc.y = n.p.y) then
									(** C'est le bordel, le chat mange la souris **)
									aux (suppr1Souris n t) mur (suppr1Souris n res)@[{h with p= mvon pc}]
								else
									aux t mur res@[{h with p = mvon pc }]
						end
					| Souris(Sa(s,d)) -> 
						(* Une fonction qui retourne l'annimal le plus proche un chat ou une soouris de sexe oposé qui n'est pas fecondée*)
						let an = prioSouris h (l@res) mur in
						let dest = destination h in
						begin
							match an with
								A(n) ->
									begin
										match n.esp with
											Chat -> aux t mur res@[{ h with p= mvon (fuite h n mur)}]
											| Souris(_) -> 
												let (p3,h2,an2) = (copule h n mur) in
												aux (modifSouris n an2 t ) mur (modifSouris n an2 res )@[h2]
									end
								| Rien ->
									if not (croise h dest mur) then
										aux t mur res@[{h with p= mvon (destination h)}]
									else
										aux t mur res@[{h with p= mvon (longe h dest mur)}]
						end
					| Souris(Sf(z,d)) ->
						let an = chatVisible h (l@res) mur in
						let dest = destination h in
						begin
							match an with
								A(n) ->
									if z > 0 then
										aux t mur res@[{h with p= mvon (fuite h n mur);esp = Souris(Sf(z-1,d))}]
									else if z = 0 && (not d) then
										let anl = (naissance h) in
										aux (t@anl) mur res@[{ h with esp = Souris(Sf(0,true))}]
									else if z = 0 && d then
										aux t mur res@[{ h with p= mvon (fuite h n mur);esp = Souris(Sa(Femelle,false))}]
									
									else
										failwith "fail"
								| Rien ->
									if z > 0 then
										if not (croise h dest mur) then
											aux t mur res@[{ h with p= mvon (destination h);esp = Souris(Sf(z-1,d))}]
										else
											aux t mur res@[{ h with p= mvon (longe h dest mur);esp = Souris(Sf(z-1,d))}]
									else if z = 0 && (not d) then
										let anl = (naissance h) in
										aux (t@anl) mur res@[{ h with esp = Souris(Sf(0,true))}]
									else if z = 0 && d then
										if not (croise h dest mur) then
											aux t mur res@[{ h with p= mvon (destination h);esp = Souris(Sa(Femelle,false))}]
										else
											aux t mur res@[{ h with p= mvon (longe h dest mur);esp = Souris(Sa(Femelle,false))}]
									else
										failwith "fail"
							end	
					| Souris(So(s,d)) ->
					let an = chatVisible h (l@res) mur  in
					let dest = destination h in
					begin
						match an with
							A(n) -> 
							if d = 0 then
								aux t mur res@[{p = mvon (fuite h n mur); pvis = h.pvis*.2.0; ract=h.ract*.2.0; esp = Souris(Sa(s,false))}]
							 else
							 	if not (croise h dest mur) then
									aux t mur res@[{h with p = mvon dest; esp = Souris(So(s,d-1))}]
								else
									aux t mur res@[{h with p = mvon (longe h dest mur);esp = Souris(So(s,d-1))}]
							| Rien ->
							if d = 0 then
								aux t mur res@[{ p = mvon dest; pvis = h.pvis*.2.0; ract=h.ract*.2.0; esp = Souris(Sa(s,false))}]
							 else
							 	if not (croise h dest mur) then
									aux t mur res@[{h with p = mvon dest; esp = Souris(So(s,d-1))}]
								else
									aux t mur res@[{h with p = mvon (longe h dest mur);esp = Souris(So(s,d-1))}]
					end
			end
		in
		aux lai mur []
					
let addCat = fun () ->
  	{p={Geo.x = (Random.float 0.5); Geo.y =(Random.float 0.5)};ract=(Random.float 0.4);pvis=(Random.float 0.5);esp=Chat}
let addMouse = fun () ->
  	{p={Geo.x = 0.5+.(Random.float 0.5); Geo.y =0.5+.(Random.float 0.5)};ract=0.5+.(Random.float 0.1);pvis=0.1+.(Random.float 0.2)
			;esp=Souris(Sa((if Random.bool() then Male else Femelle),false))}
(*---------------------------------------------------------------------------------------------- *)			

(* ********************************************************** *)
(* Fonctions d'affichage *)
(* ********************************************************** *)

let vertex {Geo.x=x; Geo.y=y} =
  GlDraw.vertex ~x ~y ()

let translate r =
  GlMat.translate ~x:r.Geo.x ~y:r.Geo.y ()

let scale s =
  GlMat.scale ~x:s ~y:s ()

let protect f g =
  try
    f();
    g()
  with e ->
    g();
    raise e;;

let mat f =
  GlMat.push();
  protect f GlMat.pop

let render prim f =
  GlDraw.begins prim;
  protect f GlDraw.ends

let circle x = Geo.point (sin x) (cos x)

let display_surface = function
  | Geo.Circle (c, r) ->
			GlDraw.color (0., 0., 1.0) ~alpha:1.;
      GlMat.push();
      mat (fun () ->
        translate c;
        scale r;
        let n = 360 in
        GlDraw.begins `line_loop;
        for i=0 to n-1 do
          vertex (circle (2. *. Geo.pi *. float i /. float n))
        done;
        GlDraw.ends ())
  | Geo.Line (v1, v2) ->
			GlDraw.color (1., 1., 1.) ~alpha:1.;
      GlDraw.begins `lines;
      List.iter vertex [v1; v2];
      GlDraw.ends ()
  | Geo.Polygon (pts) ->
			GlDraw.color (1.0, 0., 0.) ~alpha:1.;
      GlDraw.begins `polygon;
      List.iter vertex pts;
      GlDraw.ends ()

let display () =
  GlClear.clear [ `color; `depth ];
  Gl.enable `depth_test;
  GlFunc.depth_func `lequal;
  GlMat.mode `projection;
  GlMat.load_identity ();
  GlMat.ortho ~x:(0., 1.) ~y:(0., 1.) ~z:(0., 1.);
  GlMat.mode `modelview;
  GlMat.load_identity ();
  (* GlDraw.color (1., 1., 1.) ~alpha:1.; *)
  List.iter display_surface !liste_surface;
  Gl.finish ();
  Unix.sleep 0;
  Glut.swapBuffers ()

let idleS () = 
	if !continue
	then
  		liste_animaux := modifsphere (!liste_animaux) ;
  		liste_surface := (create_liste_surface_animaux !liste_animaux)@(create_liste_surface_murs !liste_murs);
		continue := false
		
let idleP () = 
	if !continue
	then
  		liste_animaux := modifpleinair !liste_animaux !liste_murs ;
  		liste_surface := (create_liste_surface_animaux !liste_animaux)@(create_liste_surface_murs !liste_murs);
		continue := false
		
let handle_key (key:int) =
	match key with
	| 27 -> exit 0
	| 13 -> continue := true (* entrée *)
	| 99 -> liste_animaux := addCat()::!liste_animaux    (* c *)
	| 115 -> liste_animaux := addMouse()::!liste_animaux
	| _ -> print_string "\n touche : " ; print_int key; print_char '\n'

let create_window (width:int) (height:int) (title:string) =
  ignore (Glut.init Sys.argv);
  Glut.initDisplayMode ~alpha:true ~double_buffer:true ~depth:true ();
  Glut.initWindowSize ~w:width ~h:height;
  ignore (Glut.createWindow ~title:title);
  GlClear.color (0., 0., 0.) ~alpha:0.;
  Gl.enable `blend;
  List.iter Gl.enable [`line_smooth; `polygon_smooth];
  List.iter (fun x -> GlMisc.hint x `nicest) [`line_smooth; `polygon_smooth];
  GlDraw.line_width 4.;
  GlFunc.blend_func ~src:`src_alpha ~dst:`one

let set_cb display idle (key_event:int->unit) =
  Glut.displayFunc ~cb:display;
  let idle_glut () = idle (); Glut.postRedisplay () in
  Glut.idleFunc ~cb:(Some idle_glut);
  Glut.keyboardFunc ~cb:(fun ~key ~x ~y -> key_event key)




(***********************************************************************)
(***********************************************************************)


let sphere () = 
	let souris1 = {p={Geo.x = 0.6; Geo.y = 0.6};ract=0.06;pvis=0.15;esp=Souris(Sa (Male,false))} in
	liste_animaux := [souris1];
	liste_murs := [];
  Random.self_init ();
  create_window 600 600 "Le chat et la souris";
  set_cb display idleS handle_key;
  Glut.mainLoop ()
  
  
  
let plein_air () = 
	let souris1 = {p={Geo.x = 0.1; Geo.y = 0.1};ract=0.2;pvis=0.4;esp=Souris(Sa (Male,false))} in
	let souris2 = {p={Geo.x = 0.5; Geo.y = 0.5};ract=0.2;pvis=0.4;esp=Souris(Sa (Femelle,false))} in
	let souris3 = {p={Geo.x = 0.2; Geo.y = 0.7};ract=0.2;pvis=0.4;esp=Souris(Sa (Femelle,false))} in
	let souris4 = {p={Geo.x = 0.8; Geo.y = 0.2};ract=0.2;pvis=0.4;esp=Souris(Sa (Femelle,false))} in
	let souris5 = {p={Geo.x = 0.5; Geo.y = 0.6};ract=0.2;pvis=0.4;esp=Souris(Sa (Femelle,false))} in
	let chat1 = {p={Geo.x = 0.9; Geo.y = 0.9};ract=0.21;pvis=0.3;esp=Chat} in
	let chat2 = {p={Geo.x = 0.9; Geo.y = 0.2};ract=0.21;pvis=0.3;esp=Chat} in
	liste_animaux := [souris1;souris2;chat1;souris3;souris4;chat2;souris5];
	liste_murs := [{p1={Geo.x=0.0;Geo.y=0.4};p2={Geo.x=0.5;Geo.y=0.8}}];
  Random.self_init ();
  create_window 600 600 "Le chat et la souris";
  set_cb display idleP handle_key;
  Glut.mainLoop ()
  

